(library (lib utils response-utils)
  (export create-html-response
          create-static-asset-response
          create-css-response)
  (import
    (except (rnrs base) let-values)
    (only (guile) lambda* λ error when display sleep)
    ;; Guile modules
    ;; alist->hash-table
    (prefix (ice-9 hash-table) ice9-hash-table:)
    ;; Guile exception handling
    (ice-9 exceptions)
    (ice-9 session)
    ;; for bytevector operations
    (ice-9 binary-ports)
    ;; SRFIs
    ;; hash tables
    (prefix (srfi srfi-69) srfi-69:)
    ;; receive form
    (prefix (srfi srfi-8) srfi-8:)
    ;; let-values
    (prefix (srfi srfi-11) srfi-11:)
    ;; list utils
    (prefix (srfi srfi-1) srfi-1:)
    ;; web server, concurrent
    (fibers web server)
    ;; standard web library
    (web request)
    (web response)
    (web uri)
    (sxml simple)
    ;; custom modules
    (prefix (fslib) fslib:)
    (lib web-location-handling)
    (file-reader)
    (lib mime-types)
    (prefix (logging) log:)
    (templates helpers)))


(define create-html-response
  (lambda* (#:optional body
            #:key
            (status 200)
            (title "This is my title!")
            (doctype "<!DOCTYPE html>\n")
            (content-type-params '((charset . "utf-8")))
            (content-type 'text/html)
            ;; Usually we have no exra headers by default.
            (extra-headers '())
            ;; If a body is provided use its templatized
            ;; form. and returns its last argument, if
            ;; previous arguments are #t.
            (sxml (and body (templatize title body))))
    "Respond to a request with the given SXML body. The SXML
is put into the HTML template, which adds html, head, title,
and body tag."
    ;; as before, answer in two parts, headers and body
    (values (build-response #:code status
                            ;; headers are an alist
                            #:headers
                            `((content-type . (,content-type ,@content-type-params))
                              ,@extra-headers))
            ;; Instead of returning the body as a string,
            ;; respond can be given a procedure, which will
            ;; be called by the web server to write out the
            ;; response to the client. This procedure gets
            ;; an output port as an argument.  So you have 2
            ;; options: return string or return procedure
            ;; which takes a port.
            (λ (port)
              (when doctype (display doctype port))
              (cond
               [sxml
                ;; TODO: prettify XML string before sending it
                (sxml->xml sxml port)]
               [else
                (sxml->xml '(p "no HTML body in response") port)])))))


(define create-static-asset-response
  (lambda* (static-asset-location
            #:key
            ;; By default assume the asset to exist in the file system.
            (status 200)
            (content-type-params '())
            (extra-headers '()))
    "Serve a static asset."
    (log:debug "serving a static asset for path:" static-asset-location)

    (let* ([mime-type (guess-mime-type static-asset-location)]
           [content-type mime-type]
           ;; Internet knowledge: If the file is binary, it needs to be served
           ;; ISO-8859-1 encoded. This needs to be specified in the response, so
           ;; that the browser knows what to do with the data.
           [content-type-params
            (if (guess-binary-file? static-asset-location)
                (srfi-1:alist-cons 'charset "ISO-8859-1" content-type-params)
                content-type-params)])

      (log:debug "responding with MIME type:" mime-type)
      (values (build-response
               #:code status
               #:headers
               `((content-type . (,content-type ,@content-type-params))
                 ,@extra-headers))
              (λ (port)
                (let ([static-asset-data (read-file-to-bytevector static-asset-location)])
                  (cond
                   [static-asset-data
                    (put-bytevector port static-asset-data)]
                   [else
                    (raise-exception
                     (make-exception
                      (make-non-continuable-error)
                      (make-exception-with-message "no data read from file")
                      (make-exception-with-irritants (list static-asset-location))
                      (make-exception-with-origin 'respond-static-asset)))])))))))


(define create-css-response
  (lambda* (css-code)
    (let ([status 200]
          [content-type-params '((charset . "utf-8"))]
          [content-type 'text/css])
      (let ([headers
             (build-response
              #:code status
              #:headers
              `((content-type
                 .
                 (,content-type ,@content-type-params))))])
        (values headers css-code)))))
